COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Game functions valmax,linemax,treemax,rectify,commontail,commonhead tryjmc
C00011 00003	(DEFPROP GAMEXX
C00012 ENDMK
C⊗;
;;; Game functions valmax,linemax,treemax,rectify,commontail,commonhead tryjmc
;;; These definitions are taken from GAME.JMC[206,LSP].

(DEFPROP GAME
         (VALMAX
	  VALMIN
	  LINEMAX
	  LINEMIN
	  TREEMAX
	  TREEMIN
	  RECTIFY
	  COMMONTAIL
	  COMMONHEAD
	  TRYJMC)
FNS)

;;; Gets the value of a list of positions when the maximizer is to move.
;;; A position is represented by the list of moves numbers of the
;;; moves that led to it.  The functions TER, IMVAL, and SUCCESSORS know
;;; about the particular game being played.
;;; These functions require auxiliaries.
;;; (TER p α β) tells whether p is a terminal position.
;;; (IMVAL p) gives the immediat value of the position.
;;; (SUCCESSORS p) gives the list of successors.
;;; (RECTIFY p) is nominally the identity function but it
;;; makes sure that the hidden board matches the position as listed.
;;; RECTIBY has further auxiliary functions.

(DEFPROP VALMAX
 (LAMBDA(U ALPHA BETA)
  (COND	((NULL U) ALPHA)
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP S ALPHA))
		  (VALMAX (CDR U) ALPHA BETA))
		 ((LESSP S BETA) (VALMAX (CDR U) S BETA))
		 (T BETA)))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
		(T (VALMIN (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)

(DEFPROP VALMIN
 (LAMBDA(U ALPHA BETA)
  (COND	((NULL U) BETA)
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP S ALPHA)) ALPHA)
		 ((LESSP S BETA) (VALMIN (CDR U) ALPHA S))
		 (T (VALMIN (CDR U) ALPHA BETA))))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
		(T (VALMAX (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)

(DEFPROP LINEMAX
 (LAMBDA(U LINE ALPHA BETA)
  (COND	((NULL U) (CONS ALPHA LINE))
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP (CAR S) ALPHA))
		  (LINEMAX (CDR U) LINE ALPHA BETA))
		 ((LESSP (CAR S) BETA)
		  (LINEMAX (CDR U)
			   (CONS (EXT (CAR U)) (CDR S))
			   (CAR S)
			   BETA))
		 (T (CONS BETA LINE))))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA)
		 (LIST (IMVAL (CAR U))))
		(T
		 (LINEMIN (SUCCESSORS (CAR U))
			  (CONS BETA (QUOTE BETA-CUTOFF))
			  ALPHA
			  BETA)))))))
EXPR)

(DEFPROP LINEMIN
 (LAMBDA(U LINE ALPHA BETA)
  (COND	((NULL U) (CONS BETA LINE))
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP (CAR S) ALPHA)) (CONS ALPHA LINE))
		 ((LESSP (CAR S) BETA)
		  (LINEMIN (CDR U)
			   (CONS (EXT (CAR U)) (CDR S))
			   ALPHA
			   (CAR S)))
		 (T (LINEMIN (CDR U) LINE ALPHA BETA))))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA)
		 (LIST (IMVAL (CAR U))))
		(T
		 (LINEMAX (SUCCESSORS (CAR U))
			  (CONS ALPHA (QUOTE ALPHA-CUTOFF))
			  ALPHA
			  BETA)))))))
EXPR)

(DEFPROP TREEMAX
 (LAMBDA(U TRMAX TRMIN ALPHA BETA)
  (COND
   ((NULL U) (LIST ALPHA TRMAX TRMIN))
   (T
    ((LAMBDA(S)
      (COND
       ((NOT (GREATERP (CAR S) ALPHA))
	(TREEMAX (CDR U)
		 TRMAX
		 (CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
		 ALPHA
		 BETA))
       ((LESSP (CAR S) BETA)
	(TREEMAX (CDR U)
		 (CONS (EXT (CAR U)) (CADR S))
		 (CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
		 (CAR S)
		 BETA))
       (T (LIST BETA (CONS (EXT (CAR U)) (CADR S)) NIL))))
     (COND
      ((TER (RECTIFY (CAR U)) ALPHA BETA)
       ((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
      (T
       (TREEMIN (SUCCESSORS (CAR U))
		NIL
		(CONS BETA (QUOTE BETA-CUTOFF))
		ALPHA
		BETA)))))))
EXPR)

(DEFPROP TREEMIN
 (LAMBDA(U TRMAX TRMIN ALPHA BETA)
  (COND
   ((NULL U) (LIST BETA TRMAX TRMIN))
   (T
    ((LAMBDA(S)
      (COND
       ((NOT (GREATERP (CAR S) ALPHA))
	(LIST ALPHA NIL (CONS (EXT (CAR U)) (CADDR S))))
       ((LESSP (CAR S) BETA)
	(TREEMIN (CDR U)
		 (CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
		 (CONS (EXT (CAR U)) (CADDR S))
		 ALPHA
		 (CAR S)))
       (T
	(TREEMIN (CDR U)
		 (CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
		 TRMIN
		 ALPHA
		 BETA))))
     (COND
      ((TER (RECTIFY (CAR U)) ALPHA BETA)
       ((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
      (T
       (TREEMAX (SUCCESSORS (CAR U))
		(CONS ALPHA (QUOTE ALPHA-CUTOFF))
		NIL
		ALPHA
		BETA)))))))
EXPR)

;;; (RECTIFY p) makes the hidden board match the nominal position.
;;; It uses (UPDATE move) and (REVERT) which are peculiar to the
;;; game being played.

(DEFPROP RECTIFY
 (LAMBDA(P)
  (PROG	(Z Q)
	(SETQ Q (COMMONTAIL P P1))
   L1	(COND ((EQUAL Q P1) (GO L2)))
	(REVERT)
	(GO L1)
   L2	(SETQ Z (LISTSUBT P P1))
   L3	(COND ((NULL Z) (RETURN P)))
	(UPDATE (CAR Z))
	(SETQ Z (CDR Z))
	(GO L3)))
EXPR)

(DEFPROP COMMONTAIL
 (LAMBDA (U V) (REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
EXPR)

(DEFPROP COMMONHEAD
 (LAMBDA(U V)
  (COND	((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) NIL)
	(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
EXPR)


(DEFUN TRYJMC (MODE WW POS)
  (PROG ()
    (NEWGAME)
    (SETQ W WW)
    (MAPC (FUNCTION UPDATE) (REVERSE POS))
    (PRINTBOARD)
    (PRINT 
	(COND ((EQ MODE 'VAL)
	      (COND (W (VALMIN (SUCCESSORS P1) -1000 1000)) 
		    (T (VALMAX (SUCCESSORS P1) -1000 1000))))
	      ((EQ MODE 'LINE)
	      (COND (W (LINEMIN (SUCCESSORS P1) NIL -1000 1000)) 
		    (T (LINEMAX (SUCCESSORS P1) NIL -1000 1000))))
	      ((EQ MODE 'TREE)
	      (COND (W (TREEMIN (SUCCESSORS P1) NIL NIL -1000 1000)) 
		    (T (TREEMAX (SUCCESSORS P1) NIL NIL -1000 1000)))) )
	) ))


(DEFPROP GAMEXX
 (VMX LMX TMX)
FNS)

(DEFPROP VMX
 (LAMBDA (P) (RECTIFY P) (COND (W (VALMIN (SUCCESSORS P) -1000 1000)) (T (VALMAX (SUCCESSORS P) -1000 1000))))
EXPR)

(DEFPROP LMX
 (LAMBDA(P)
  (RECTIFY P)
  (COND (W (LINEMIN (SUCCESSORS P) NIL -1000 1000)) (T (LINEMAX (SUCCESSORS P) NIL -1000 1000))))
EXPR)

(DEFPROP TMX
 (LAMBDA(P)
  (RECTIFY P)
  (COND (W (TREEMIN (SUCCESSORS P) NIL NIL -1000 1000)) (T (TREEMAX (SUCCESSORS P) NIL NIL -1000 1000))))
EXPR)